module Dot where

import Data.Graph.Inductive.Graph (Node,Edge,UNode,LNode,LEdge,edges,nodes,lab,mkGraph)
import Random (StdGen,mkStdGen,randomR)
import List (find)
import Coloring (get_colors)
import Data.Graph.Inductive.Tree (Gr,UGr)
import Utils (add_in_set_mode, get_label)

graph_to_dot_string :: Gr Int () -> String
graph_to_dot_string graph =
	concat ("graph G {\n":[node_to_dot_string nd | nd <- nodes graph] ++ [edge_to_dot_string edg | edg@(begin,end) <- edges graph, begin <= end] ++ ["}"]) where
	
	colorList :: [(Int,Float,Float,Float)]
	colorList = [(color,(3/) $ (3+) $ fromIntegral color,(3/) $ (3+) $ fromIntegral color,(3/) $ (3+) $ fromIntegral color)| color <- (get_colors graph)]
		
	node_to_dot_string :: Node -> String
	node_to_dot_string node =
		case (find (\(color,_,_,_) -> color == get_label graph node) colorList) of
		Just (color,hue,sat,bra) -> 
			concat [show node, " [color=\"", show hue, " ", show sat, " ", show bra, "\" label=\"", show node, " : c", show color, "\"];\n"]
	
	edge_to_dot_string :: Edge -> String
	edge_to_dot_string (node1,node2)
		| node1 <= node2 =
				concat[show node1, " -- ", show node2, ";\n"]
		|otherwise = ""	
				
dot_string_to_graph :: String -> UGr
dot_string_to_graph str =
	case lines str of
	hd:text ->
		case words hd of
		["graph",_,"{"] ->
			case get_edges of 
			(nds,edgs) -> mkGraph nds edgs
		_ -> error $ concat["Invalid header\n", hd]
		where
	
		get_edges :: ([LNode ()],[LEdge ()])											
		get_edges = foldl parse_line ([],[]) text
			where
			parse_line val@(nds,edgs) line = 
				case words line of
				[begin,"--",end] -> (add_in_set_mode nds (begin_value,()) `add_in_set_mode` (end_value,())
									 ,add_in_set_mode edgs (begin_value,end_value,()) `add_in_set_mode` (end_value,begin_value,()))
					where
					begin_value = read begin
					end_value = read $ takeWhile (\x -> x /= ';') end
				["}"] -> val
				[begin] -> (add_in_set_mode nds (begin_value,()),edgs)
					where
					begin_value = read $ takeWhile (\x -> x /= ';') begin
				_ -> error $ concat ["Invalid dot file ", show $ words line]
	_ -> error $ ("Invalid dot file "++) $ show $ lines str